home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.05 May 91 / Math Parser ƒ / ParserProcs / Parser < prev    next >
Encoding:
Text File  |  1990-09-17  |  3.4 KB  |  153 lines  |  [TEXT/PJMM]
  1. unit Parser;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ParserGlobals;
  7.  
  8.     procedure parser (var ktot: integer; var ty: hdlstringarray0; var typ: hdlstringarray0; var typr: hdlintarray0; var nodetable: hdlnoderecord; var numnodes: integer; var error: str255);
  9.  
  10. implementation
  11.  
  12.  
  13.     procedure parser;
  14.  
  15.         label
  16.             992, 993;
  17.  
  18.         var
  19.             i, j, k, l, m, n, del, jtot: integer;
  20.             s1, s2, s3: boolean;
  21.  
  22.         procedure setnodefields (l, m, n: integer);
  23.  
  24.         begin
  25.             numnodes := numnodes + 1;
  26.             nodetable^^[numnodes].optype := typ^^[l];
  27.             nodetable^^[numnodes].loptype := typ^^[m];
  28.             nodetable^^[numnodes].roptype := typ^^[n];
  29.             nodetable^^[numnodes].op.index := ty^^[l];
  30.             nodetable^^[numnodes].lop.index := ty^^[m];
  31.             nodetable^^[numnodes].rop.index := ty^^[n];
  32.         end;
  33.  
  34.         procedure reset (l, m, n: integer);
  35.             var
  36.                 k: integer;
  37.         begin
  38.             jtot := jtot - n;
  39.             for k := l to m do
  40.                 begin
  41.                     ty^^[k] := ty^^[k + n];
  42.                     typr^^[k] := typr^^[k + n];
  43.                     typ^^[k] := typ^^[k + n];
  44.                 end;
  45.         end;
  46.  
  47.         procedure setnodetoken (l: integer);
  48.         begin
  49.             ty^^[l] := stringof(numnodes : 2);
  50.             typ^^[l] := 'node';
  51.             typr^^[l] := 0;
  52.         end;
  53.  
  54.  
  55.     begin
  56.  
  57.  
  58.         error := '';
  59.         jtot := ktot;
  60.  
  61.         numnodes := 0;
  62.         j := 0;
  63.         repeat
  64.             j := j + 1;
  65.             if j < 1 then
  66.                 j := 1;
  67.  
  68.             s1 := (typ^^[j + 1] = 'constant') or (typ^^[j + 1] = 'variable') or (typ^^[j + 1] = 'real') or (typ^^[j + 1] = 'node');
  69.             s2 := (typ^^[j - 1] = 'constant') or (typ^^[j - 1] = 'variable') or (typ^^[j - 1] = 'real') or (typ^^[j - 1] = 'node');
  70.             s3 := (typ^^[j - 3] = 'constant') or (typ^^[j - 3] = 'variable') or (typ^^[j - 3] = 'real') or (typ^^[j - 3] = 'node');
  71.  
  72.             if ((typ^^[j] = 'unary') or (typ^^[j] = 'function')) and s1 then
  73.                 begin
  74.                     setnodefields(j, j + 1, j + 1);
  75.                     setnodetoken(j);
  76.                     reset(j + 1, jtot, 1);
  77.                     j := j - 2;
  78.                     goto 992;
  79.                 end;
  80.  
  81.             if (ty^^[j] = quote) and s2 then
  82.                 begin
  83.                     setnodefields(j, j - 1, j - 1);
  84.                     setnodetoken(j - 1);
  85.                     j := j - 1;
  86.                     reset(j + 1, jtot, 1);
  87.                     j := j - 2;
  88.                     goto 992;
  89.                 end;
  90.  
  91.             if (typ^^[j] = 'binary') and (ty^^[j] <> '(') then
  92.  
  93.                 begin
  94.  
  95.                     if (j - 2 >= 0) and (typ^^[j - 2] <> 'binary') and (typ^^[j - 2] <> 'unary') and (typ^^[j - 2] <> 'function') then
  96.                         begin
  97.                             error := concat(ty^^[j - 2], ' is not a binary token ');
  98.                             goto 993;
  99.                         end;
  100.  
  101.                     while (j - 2 >= 0) and (typr^^[j - 2] >= typr^^[j]) and (typ^^[j - 2] <> 'unary') and (typ^^[j - 2] <> 'function') do
  102.  
  103.                         begin
  104.  
  105.                             if (not s2) and (not s3) then
  106.                                 begin
  107.                                     error := concat(ty^^[j - 3], ' and ', ty^^[j - 1], '  are not both operand tokens');
  108.                                     goto 993;
  109.                                 end;
  110.  
  111.                             setnodefields(j - 2, j - 3, j - 1);
  112.                             setnodetoken(j - 3);
  113.  
  114.                             j := j - 3;
  115.                             reset(j + 1, jtot, 2);
  116.                             goto 992;
  117.  
  118.  
  119.                         end;
  120.  
  121.                     if ty^^[j] = rightparen then
  122.                         begin
  123.  
  124.                             if (ty^^[j - 2] <> leftparen) or (not s2) then
  125.                                 begin
  126.                                     error := ' ty^^[j-2] <> leftparen token or ty^^[j-1] <> an operand token';
  127.                                     error := concat(ty^^[j - 2], ' is not a left parenthesis token or ', ty^^[j - 1], '  is not an operand token');
  128.                                     goto 993;
  129.                                 end;
  130.  
  131.                             ty^^[j - 2] := ty^^[j - 1];
  132.                             typr^^[j - 2] := typr^^[j - 1];
  133.                             typ^^[j - 2] := typ^^[j - 1];
  134.  
  135.                             j := j - 2;
  136.                             reset(j + 1, jtot, 2);
  137.                             j := j - 2;
  138.  
  139.                         end;
  140. 992:
  141.                 end;
  142.  
  143.         until ty^^[j] = semicolon;
  144.  
  145.         if j <> 2 then
  146.             error := 'possible incorrect pairing of parentheses';
  147.  
  148. 993:
  149.         ktot := jtot;
  150.     end;
  151.  
  152.  
  153. end.